Celestin Apprentice 4/Apprentice-Release4.iso/Source Code/Libraries/PNL Libraries/MyStandardGetFolder.p

Text File | 1995-06-09 | 4.3 KB | 137 lines | [TEXT/CWIE]

unit MyStandardGetFolder;

interface

    uses
        StandardFile;

    procedure StandardGetFolder (where: Point; message: Str255; var mySFReply: StandardFileReply);
{     Upon return, the sfFile field of the SFReply record contains the volume  }
{     reference number and directory ID that specify the folder the user       }
{     chose. It also passes back the name of the chosen folder.  The sfGood    }
{     field is set to true if the user chose a folder, or false if not.        }

implementation

    uses
        TextUtils, Aliases, Script, MyStrings, MyFileSystemUtils, MyDialogs;

    const
        rGetFolderButton = 10;
        rGetFolderMessage = 11;
        rGetFolderSelectString = 12;
        kFolderBit = $0010;
        rGetFolderDialog = 2008;

    type
        StandardFileReplyPtr = ^StandardFileReply;

    var
        gCurrentSelectedFolder: str255;

    function MyCustomGetDirectoryFileFilter (var myPB: CInfoPBRec; ignored: Ptr): boolean;
    begin
        ignored := ignored; { UNUSED! }
        MyCustomGetDirectoryFileFilter := BAND(myPB.ioFlAttrib, kFolderBit) = 0;
    end;

    function MyCustomGetDirectoryDlogHook (item: integer; theDialog: DialogPtr; mySFRPtr: StandardFileReplyPtr): integer;

        procedure SetButtonTitle (name: Str255);
            var
                resultCode: integer;
                width: integer;
                template, s: str255;
                itemRect: rect;
        begin
            if gCurrentSelectedFolder <> name then begin
                gCurrentSelectedFolder := name;
                GetItemText(theDialog, rGetFolderSelectString, template); { "Select “^1”" template }
                GetDItemRect(theDialog, rGetFolderButton, itemRect);
                SPrintS3 (s,template,'','','');
                width := (itemRect.right - itemRect.left) - StringWidth(s);
                resultCode := TruncString(width, name, smTruncEnd);
                SPrintS3 (s,template,name,'','');
                SetDCtlTitle(theDialog, rGetFolderButton, s);
                ValidRect(itemRect);
            end;
        end;

        procedure SetFolderButtonTitle (vrn: integer; dirID: longInt);
            var
                name: str63;
                pb: CInfoPBRec;
                oe: OSErr;
        begin
            oe := MyGetCatInfo(vrn, dirID, name, -1, pb);
            if oe = noErr then begin
                SetButtonTitle(name);
            end;
        end;

        var
            wrefcon:longInt;
    begin
        wrefcon:=GetWRefCon(theDialog);
        if OSType(wrefcon) = sfMainDialogRefCon then begin
            if item = sfHookFirstCall then begin
                SetItemText(theDialog, rGetFolderMessage, gCurrentSelectedFolder);
                gCurrentSelectedFolder := '';
            end else begin
                if mySFRPtr^.sfFile.name = '' then begin
                    GetSFLocation(mySFRPtr^.sfFile.vRefNum, mySFRPtr^.sfFile.parID); { these aren't always set properly }
                    SetFolderButtonTitle(mySFRPtr^.sfFile.vRefNum, mySFRPtr^.sfFile.parID);
                end
                else begin
                    SetButtonTitle(mySFRPtr^.sfFile.name);
                end;
            end;

            if item = rGetFolderButton then begin
                item := sfItemCancelButton;
                mySFRPtr^.sfGood := true;
            end;

        end;
        MyCustomGetDirectoryDlogHook := item;
    end;

    procedure StandardGetFolder (where: Point; message: Str255; var mySFReply: StandardFileReply);
        var
            theTypeList: SFTypeList;
            pb: CInfoPBRec;
            isfolder, wasaliased: boolean;
            oe: OSErr;
    begin
        gCurrentSelectedFolder := message;

        CustomGetFile(@MyCustomGetDirectoryFileFilter, -1, @theTypeList, mySFReply, rGetFolderDialog, where, @MyCustomGetDirectoryDlogHook, nil, nil, nil, @mySFReply);

    {*-------------------------------------------------------------------------}
    { Ok, now the reply record contains the volume reference number and the    }
    { name of the selected folder. We need to use PBGetCatInfo to get the      }
    { directory ID of the selected folder.                                     }
    {-------------------------------------------------------------------------*}
        if mySFReply.sfGood then begin { Don't call PBGetCatInfo on cancel! }

            if mySFReply.sfFile.name <> '' then begin { get the dirID of the selected folder }
                oe := ResolveAliasFile(mySFReply.sfFile, true, isfolder, wasaliased);
                if (oe = noErr) & not isfolder then begin
                    oe := -1;
                end;
                if oe = noErr then begin
                    oe := MyGetCatInfo (mySFReply.sfFile.vRefNum, mySFReply.sfFile.parID, mySFReply.sfFile.name, 0, pb);
                end;
                mySFReply.sfGood := oe = noErr;

                mySFReply.sfFile.parID := pb.ioDrDirID;
                mySFReply.sfFile.name := '';
            end;
            if oe = noErr then begin { get the name of the selected folder }
                oe := MyGetCatInfo (mySFReply.sfFile.vRefNum, mySFReply.sfFile.parID, mySFReply.sfFile.name, -1, pb);
            end;
        end;

    end;

end.